home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / HTML and CSS Modes / htmlUtils.tcl < prev    next >
Encoding:
Text File  |  1997-12-10  |  68.2 KB  |  2,291 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlUtils.tcl"
  6.  #                                    created: 96-09-01 13.01.43 
  7.  #                                last update: 3/12/97 {8:43:43 am} 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0.3
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlUtils.tcl {} {}
  25.  
  26. #
  27. # Mark file
  28. #
  29. proc HTML::parseFuncs {} {
  30.     return [htmlMarkFile2 0]
  31. }
  32.  
  33. proc HTML::MarkFile {} {
  34.     htmlMarkFile2 1
  35.     message "Marks set."
  36. }
  37.  
  38. proc htmlMarkFile2 {markfile} {
  39.     set pos 0
  40.     set exp {<[Hh][1-6][^>]*>}
  41.     set exp2 {</[Hh][1-6]>}
  42.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  43.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  44.         set start [lindex $rs 0]
  45.         set end [lindex $res 1]
  46.         set text [getText $start $end]
  47.         # Remove tabs and returns from text.
  48.         regsub -all "\[\t\r\]+" $text " " text
  49.         # remove all tags from text
  50.         set headtext [htmlTagStrip $text]
  51.         # Set mark only on one line.
  52.         if {$end > [nextLineStart $start]} {
  53.             set end [expr [nextLineStart $start] - 1]
  54.         }
  55.         
  56.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  57.  
  58.         if {$indlevel > 0 && $indlevel < 7} {
  59.             set lab [string range "       " 2 $indlevel]
  60.             append lab $lab $indlevel " " $headtext
  61.             # Cut the menu item if it's longer than 30 letters, not to make it too long.
  62.             if {[string length $lab] > 30} {
  63.                 set lab "[string range $lab 0 29]…"
  64.             }
  65.             if {$markfile} {
  66.                 setNamedMark $lab $start $start $end
  67.             } else {
  68.                 lappend parse $lab [lineStart $start]
  69.             }
  70.         }
  71.         set pos $end
  72.     }
  73.     if {!$markfile} {return $parse}
  74. }
  75.  
  76.  
  77. #
  78. # return positions of tags of including elements, as a list of 5 elements --
  79. # openstart openend closestart closeend elementname.
  80. # Elements without a closing tag are ignored.
  81. # args: point to start search backward from; point which must be enclosed
  82. #
  83. # if any problem, return just {0}
  84. #
  85. proc htmlGetContainer {curPos inclPos} {
  86.  
  87.     set startPos $curPos
  88.     set startPos2 $inclPos
  89.     set searchFinished 0
  90.     message "Searching for enclosing tags…"
  91.     while {!$searchFinished} {
  92.         # find first tag
  93.         set isStartTag 0
  94.         while {!$isStartTag} {
  95.             if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  96.                 message ""
  97.                 return {0}
  98.             }
  99.             set tag1start [lindex $res 0]
  100.             set tag1end   [lindex $res 1]
  101.             # get element name
  102.             if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  103.                 message ""
  104.                 return {0}
  105.             }
  106.             # is this a closing tag?
  107.             if {[string index $tag 0] != "/"} { set isStartTag 1}
  108.             set startPos [expr $tag1start - 1]
  109.         }
  110.         # find closing tag
  111.         set res [htmlGetClosing $tag $tag1end]
  112.         
  113.         set tag2start [lindex $res 0]
  114.         set tag2end   [lindex $res 1]
  115.         # If container enclosed along with us, or there is no closing tag,
  116.         # continue searching.
  117.         if {![llength $res] || $tag2end < $inclPos} {
  118.             set startPos [expr $tag1start - 1]
  119.         } else {
  120.             set Container "$tag1start $tag1end $tag2start $tag2end" 
  121.             set searchFinished 1
  122.         }
  123.     }
  124.     
  125.     message ""
  126.     return [concat $Container [string toupper $tag]]
  127. }
  128.  
  129.  
  130. #
  131. # return position an opening tag if the first element to the left
  132. # of startPos is an element with only an opening tag, as a list of 3 elements --
  133. # openstart openend elementname.
  134. #
  135. # if any problem, return empty string
  136. #
  137.  
  138. proc htmlGetOpening {startPos} {
  139.     
  140.     while {1} {
  141.         if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  142.             return
  143.         }
  144.         set tag1start [lindex $res 0]
  145.         set tag1end   [lindex $res 1]
  146.         # get element name
  147.         if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  148.             return
  149.         }
  150.         # is this a closing tag?
  151.         if {[string index $tag 0] == "/"} {return}
  152.         # comment?
  153.         if {[string range $tag 0 2] != "!--"} {break}
  154.         set startPos [expr $tag1start - 1]
  155.     }
  156.     
  157.     # find closing tag
  158.     set res [htmlGetClosing $tag $tag1end]
  159.     
  160.     if {![llength $res] } {
  161.         return "$tag1start $tag1end [string toupper $tag]"
  162.     } else {
  163.         return
  164.     }
  165.     
  166. }
  167.  
  168. proc htmlGetClosing {tag sPos} {
  169.     set x </${tag}>
  170.     set sPos2 $sPos
  171.     while {1} {
  172.         set res [search -s -f 1 -r 1 -i 1 -m 0 -n $x $sPos]
  173.         # Found any closing tag.
  174.         if {![llength $res]} {break}
  175.         # Look for another opening tag of the same element.
  176.         set y "<${tag}(\[ \\t\\r\]+|>)"
  177.         set res2 [search -s -f 1 -r 1 -i 1 -m 0 -n $y $sPos2]
  178.         # Is it further away than the closing tag.
  179.         if {![llength $res2] || [lindex $res2 0] > [lindex $res 0]} {break}
  180.         # If not, find the next closing tag.
  181.         set sPos [lindex $res 1]
  182.         set sPos2 [lindex $res2 1]
  183.     }
  184.     return $res
  185. }
  186.  
  187. # Change choice of an attribute with pre-defined choices.
  188. proc htmlChangeChoice {} {
  189.     set pos [expr [getPos] - 1]
  190.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  191.     [lindex $res 1] < $pos || 
  192.     ![regexp {<([^ \t\r>]+)} [eval getText $res] tmp tag] ||
  193.     [catch {search -s -f 0 -r 1 -i 0 -m 0 {[ \t\r]+[^=]+=\"?[^\" \t\r>]*\"?} $pos} res1] ||
  194.     [lindex $res1 1] < $pos ||
  195.     ![regexp {([^=]+=)((\"[^\" \t\r]*\")|([^\" \t\r>]*))} [eval getText $res1] tmp attr choice]} {
  196.         beep
  197.         message "Current position is not at an attribute with choices."
  198.         return
  199.     }
  200.     set pos0 [expr [lindex $res1 0] + [string length $attr]]
  201.     set pos1 [expr $pos0 + [string length $choice]]
  202.     set choice [string trim $choice \"]
  203.     set tag [string toupper $tag]
  204.     if {$tag == "INPUT"} {
  205.         if {![regexp -nocase {type=(([^\" \t\r>]+)|(\"[^\" \t\r]+\"))} [eval getText $res] tmp tag]} {
  206.             beep
  207.             message "Current position is not at an attribute with choices."
  208.             return
  209.         }
  210.         set tag [string trim [string toupper $tag] \"]
  211.     }
  212.     if {$tag == "LI"} {
  213.         set ltype [htmlFindList]
  214.         if {$ltype == "UL"} {
  215.             set tag "LI IN UL"
  216.         } elseif {$ltype == "OL"} {
  217.             set tag "LI IN OL"
  218.         }            
  219.     }
  220.     set attr [string trim [string toupper $attr]]
  221.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set choice [string toupper $choice]}
  222.     set choices [htmlGetChoices $tag]
  223.     foreach c $choices {
  224.         if {[string match "${attr}*" $c]} {
  225.             lappend matches [string range $c [string length $attr] end]
  226.         }    
  227.     }
  228.     if {![info exists matches]} {
  229.         beep
  230.         message "Current position is not at an attribute with choices."
  231.         return
  232.     }
  233.     if {[set this [lsearch -exact $matches $choice]] < 0} {set this 0}
  234.     incr this
  235.     if {$this == [llength $matches]} {set this 0}
  236.     set this [lindex $matches $this]
  237.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set this [htmlSetCase $this]}
  238.     replaceText $pos0 $pos1 "\"$this\""
  239.     goto [expr ($pos0 + [string length $this] > $pos) ? $pos + 1 : $pos0 + [string length $this] + 1]
  240. }
  241.  
  242.  
  243. # Save current window and uploads it to the ftp server.
  244. proc htmlSavetoFTPServer {} {
  245.     global htmlPasswords HTMLmodeVars ftpSig
  246.  
  247.     set win [stripNameCount [lindex [winNames -f] 0]]
  248.     if {[set this [htmlThisFilePath 4]] == ""} {return}
  249.     set home [lindex $this 3]
  250.     if {$home == "" && [lindex $this 0] != "file:///"} {set home [htmlInWhichHomePage "[lindex $this 0][lindex $this 1]"]}
  251.     if {$home == "" || [lindex $this 4] == "4"} {
  252.         alertnote "Current window is not in a home page folder."
  253.         return
  254.     }
  255.     
  256.     foreach f $HTMLmodeVars(FTPservers) {
  257.         if {[lindex $f 0] == $home} {set serv $f}
  258.     }
  259.     if {![info exists serv]} {
  260.         alertnote "No ftp server specified for this home page."
  261.         htmlHomePages "[lindex $this 0][lindex $this 1]"
  262.         return
  263.     }
  264.     
  265.     if {[lindex $serv 3] != ""} {set htmlPasswords($home) [lindex $serv 3]}
  266.     if {![info exists htmlPasswords($home)]} {
  267.         if {![catch {htmlGetPassword [lindex $serv 1]} pword]} {
  268.             set htmlPasswords($home) $pword
  269.         } else {
  270.             return
  271.         }
  272.     }
  273.     save
  274.     set path [lindex $this 2]
  275.     if {[lindex $serv 4] != ""} {set path [join [list [lindex $serv 4] $path] /]}
  276.     if {![info exists ftpSig] || ![htmlCheckRunning $ftpSig] && [catch {app::launchBack $ftpSig}]} {
  277.         getApplSig "Please locate your ftp application" ftpSig
  278.         app::launchBack $ftpSig
  279.     }
  280.     currentReplyHandler htmlHandleReply
  281.     switch $ftpSig {
  282.         Arch -
  283.         FTCh {AEBuild -r -q -t 30000 '$ftpSig' Arch Stor ---- [makeAlis $win] FTPh "“[lindex $serv 1]”" FTPc "“$path”" ArGU "“[lindex $serv 2]”" ArGp "“$htmlPasswords($home)”"}
  284.         Woof {
  285.             set path [string range $path 0 [expr [string last / $path] - 1]]
  286.             AEBuild -r -q -t 30000 '$ftpSig' PURL PURL ---- [makeAlis $win] dest "“ftp://[lindex $serv 2]:$htmlPasswords($home)@[lindex $serv 1]/$path”"
  287.         }
  288.     }
  289. }
  290.  
  291. proc htmlHandleReply {reply} {
  292.     global htmlPasswords
  293.     set ans [string range $reply 11 end]
  294.     if {[regexp {^errs:“([^”]+)”} $ans dum err]} {
  295.         # Fetch error
  296.         if {[regexp {Error: (.*)} $err dum err2]} {set err $err2}
  297.         alertnote "Ftp error: $err"
  298.         unset htmlPasswords
  299.     } elseif {[regexp {^'----':(-?[0-9]*)} $ans dum err]} {
  300.         if {$err != "0"} {
  301.             # Anarchie error.
  302.             message "Ftp error."
  303.             unset htmlPasswords
  304.         } else {
  305.             message "Document uploaded to ftp server."
  306.         }
  307.     } elseif {$ans == "\\\}"} {
  308.         message "Document uploaded to ftp server."
  309.     } else {
  310.         return 0
  311.     }
  312.     return 1
  313. }
  314.  
  315.  
  316. proc htmlGetPassword {host} {
  317.     set values [dialog -w 300 -h 90 -t "Password for $host:" 10 20 290 30 \
  318.         -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  319.     if {[lindex $values 2]} {error "Cancel"}
  320.     return [string trim [lindex $values 0]]
  321. }
  322.  
  323. proc htmlForgetPasswords {} {
  324.     global htmlPasswords
  325.     message "Passwords forgotten."
  326.     unset htmlPasswords
  327. }
  328.  
  329. # Calculate the total size of a document includes images etc.
  330. proc htmlDocumentSize {} {
  331.     # Get path to this window.
  332.     if {[set thisURL [htmlThisFilePath 3]] == ""} {return}
  333.     set exp1 "<!--|\[ \\t\\n\\r\]+(SRC=|LOWSRC=|DYNSRC=|BACKGROUND=)(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  334.     set exp2 {/\*|[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  335.     set commStart1 "<!--"
  336.     set commEnd1 "-->"
  337.     set commStart2 {/*}
  338.     set commEnd2 {*/}
  339.     set size 0
  340.     set counted {}
  341.     set external 0
  342.     set notfound 0
  343.     for {set i 1} {$i < 3} {incr i} {
  344.         set pos 0
  345.         set exp [set exp$i]
  346.         set commStart [set commStart$i]
  347.         set commEnd [set commEnd$i]
  348.         while {![catch {search -s -f 1 -i 1 -m 0 -r 1 $exp $pos} res]} {
  349.             set restxt [eval getText $res]
  350.             # Comment?
  351.             if {$restxt == $commStart} {
  352.                 if {![catch {search -s -f 1 -m 0 -i 0 -r 0 -- $commEnd [lindex $res 1]} res]} {
  353.                     set pos [lindex $res 1]
  354.                     continue
  355.                 } else {
  356.                     break
  357.                 }
  358.             }
  359.             # Get path to link.
  360.             regexp -nocase $exp $restxt dum1 dum2 linkTo
  361.             set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  362.             if {![catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  363.                 if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  364.                     if {[lsearch -exact $counted $linkToPath] < 0} {
  365.                         getFileInfo $linkToPath arr
  366.                         incr size $arr(datalen)
  367.                         lappend counted $linkToPath
  368.                     }
  369.                 } else {
  370.                     set notfound 1
  371.                 }
  372.             } else {
  373.                 set external 1
  374.             }
  375.             set pos [lindex $res 1]
  376.         }
  377.     }
  378.     incr size [maxPos]
  379.     if {$size > 1000} {
  380.         set size "[expr $size /1024] kB"
  381.     } else {
  382.         append size " bytes"
  383.     }
  384.     set txt "Total size: $size."
  385.     if {$notfound} {append etxt "Some files not found. "}
  386.     if {$external} {append etxt "External sources excluded."}
  387.     if {$notfound || $external} {append txt " ([string trim $etxt])"}
  388.     alertnote $txt
  389. }
  390.  
  391. #
  392. # dividing line
  393. #
  394. proc htmlCommentLine {} {
  395.     global HTMLmodeVars fillColumn
  396.     set wordWrap    $HTMLmodeVars(wordWrap)
  397.     set comStr    [htmlCommentStrings]
  398.     set prefixString [lindex $comStr 0]
  399.     set suffixString [lindex $comStr 1]
  400.     set s "===================================================================================="
  401.     set l [expr [string length $prefixString] + [string length $suffixString]]
  402.     if {$wordWrap} { 
  403.         set l [expr $fillColumn - $l - 1] 
  404.     } else {
  405.         set l [expr 75 - $l - 1]
  406.     }
  407.     insertText [htmlOpenCR [htmlFindNextIndent]] $prefixString [string range $s 0 $l] $suffixString "\r"
  408. }
  409.  
  410.  
  411. # Removes all tab marks from the current selection (if there is one) 
  412. # or the current document, maintaining the cursor position in the 
  413. # latter case. Stolen from latexMacros.tcl written by Tom Scavo.
  414. proc htmlRemoveMarks {} {
  415.  
  416.     set subs1 0; set subs2 0; set subs3 0
  417.     set pos [getPos]
  418.     if {[set start $pos] == [set end [selEnd]]} {
  419.         set messageString "document"
  420.         set start 0
  421.         set end [maxPos]
  422.         set text1 [getText $start $pos]
  423.         set subs1 [regsub -all {•} $text1 {} text1]
  424.         set text2 [getText $pos $end]
  425.         set subs2 [regsub -all {•} $text2 {} text2]
  426.         append text $text1 $text2
  427.     } else {
  428.         set messageString "selection"
  429.         set text [getText $start $end]
  430.         set subs3 [regsub -all {•} $text {} text]
  431.     }
  432.     if {$subs1 || $subs2 || $subs3} then {
  433.         replaceText $start $end $text
  434.         if {$messageString == "document"} then {
  435.             goto [expr $pos - $subs1]
  436.         } else {
  437.             set end [getPos]
  438.             select $start $end
  439.         }
  440.         set subs [expr $subs1 + $subs2 + $subs3]
  441.         message "$subs tab marks removed from $messageString."
  442.     } else {
  443.         message "No tab marks found in $messageString."
  444.     }
  445. }
  446.  
  447.  
  448. #===============================================================================
  449. # Character translation
  450. #===============================================================================
  451.  
  452. #
  453. # Converting  characters to HTML entities.
  454. #
  455. # 1 = < > &
  456. # 0 = áé etc.
  457. proc htmlCharacterstohtml {ltgtamp} {
  458.     global htmlSpecialCharacter 
  459.     global htmlSpecialCapCharacter htmlSpecialSymbCharacter
  460.     
  461.     if {$ltgtamp} {
  462.         set charlist {& < >}
  463.     } else {    
  464.         foreach a [array names htmlSpecialCharacter] {
  465.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  466.                 lappend charlist $a
  467.             }
  468.         }
  469.         
  470.         foreach a [array names htmlSpecialCapCharacter] {
  471.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  472.                 lappend charlist $a
  473.             }
  474.         }
  475.         lappend charlist ¡ ¿
  476.     }
  477.     
  478.     set subs1 0;  set lett 0
  479.     set pos [getPos]
  480.     if {[set start $pos] == [set end [selEnd]]} {
  481.         if {$ltgtamp && \
  482.         [askyesno "There is no selection. Really translate < > & in whole document?"] == "no"} {return}
  483.         set messageString "document"
  484.         set start 0
  485.         set end [maxPos]
  486.         set isDoc 1
  487.     } else {
  488.         set messageString "selection"
  489.         set isDoc 0
  490.     }
  491.     message "Translating…"
  492.     set text [getText $start $end]
  493.     set tmp $text
  494.     set upos $pos
  495.     set st $start
  496.     if {!$ltgtamp} {
  497.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  498.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  499.             if {[expr $st + [lindex $str 1]] < $upos} {
  500.                 incr pos [expr 17 - [string length $sv]]
  501.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  502.                 incr pos [expr $st + [lindex $str 0] - $upos]
  503.             }
  504.             lappend savestr $sv
  505.             set tmp [string range $tmp [lindex $str 1] end]
  506.             incr st [lindex $str 1]
  507.         }
  508.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  509.     }
  510.     if {$isDoc} {    
  511.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  512.         set text2 [string range $text [expr $pos - $start] end]
  513.     } else {
  514.         set text1 $text
  515.     }
  516.     foreach char $charlist {
  517.  
  518.         if {[info exists htmlSpecialCharacter($char)]} {
  519.             set rtext "\\&$htmlSpecialCharacter($char);"
  520.         } elseif {[info exists htmlSpecialCapCharacter($char)]} {
  521.             set rtext "\\&$htmlSpecialCapCharacter($char);"
  522.         } elseif {[info exists htmlSpecialSymbCharacter($char)]} {
  523.             set rtext "\\&$htmlSpecialSymbCharacter($char);"
  524.         } elseif {$char == ">"} {
  525.             set rtext "\\>" 
  526.         } elseif {$char == "<"} {
  527.             set rtext "\\<"
  528.         } elseif {$char == "&"} {
  529.             set rtext "\\&"
  530.         }
  531.         
  532.         set subNum [regsub -all $char $text1 [set rtext] text1]
  533.         incr subs1 [expr $subNum * ([string length $rtext] - 2)]
  534.         incr lett $subNum
  535.         if {$isDoc} {
  536.             incr lett [regsub -all $char $text2 [set rtext] text2]
  537.         }
  538.         
  539.     }
  540.     set text $text1
  541.     if {$isDoc} {append text $text2}
  542.     if {$lett} {
  543.         if {[info exists savestr]} {
  544.             set i 0
  545.             set tmp ""
  546.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  547.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  548.                 append tmp [lindex $savestr $i]
  549.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  550.                 incr i
  551.             }
  552.             set text "$tmp$text"
  553.         }
  554.         replaceText $start $end $text
  555.         if {$isDoc} {
  556.             goto [expr $upos + $subs1]
  557.         } else {
  558.             set end [getPos]
  559.             select $start $end
  560.         }
  561.     }
  562.     message "$lett characters translated in $messageString."
  563. }
  564.  
  565.  
  566.  
  567. #
  568. # Converting HTML entities to characters.
  569. #
  570. # 1 = < > &
  571. # 0 = áé etc.
  572. proc htmltoCharacters {ltgtamp} {
  573.     global htmlCharacterSpecial  
  574.     global htmlCapCharacterSpecial 
  575.     
  576.     message "Translating…"
  577.     
  578.     if {$ltgtamp} {
  579.         set entitylist {"&" "<" ">"} 
  580.     } else {
  581.         foreach a [array names htmlCharacterSpecial] {
  582.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  583.                 lappend entitylist "&$a;"
  584.             }
  585.         }
  586.         
  587.         foreach a [array names htmlCapCharacterSpecial] {
  588.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  589.                 lappend entitylist "&$a;"
  590.             }
  591.         }
  592.         # ¡ ¿
  593.         lappend entitylist "¡" "¿"
  594.     }
  595.     set subs1 0;  set lett 0
  596.     set pos [getPos]
  597.     if {[set start $pos] == [set end [selEnd]]} {
  598.         # Move position to linestart to make sure no letter is split.
  599.         set pos [lineStart $pos]
  600.         set messageString "document"
  601.         set start 0
  602.         set end [maxPos]
  603.         set isDoc 1
  604.     } else {
  605.         set messageString "selection"
  606.         set isDoc 0
  607.     }
  608.  
  609.     set text [getText $start $end]
  610.     set tmp $text
  611.     set upos $pos
  612.     set st $start
  613.     if {!$ltgtamp} {
  614.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  615.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  616.             if {[expr $st + [lindex $str 1]] < $upos} {
  617.                 incr pos [expr 17 - [string length $sv]]
  618.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  619.                 incr pos [expr $st + [lindex $str 0] - $upos]
  620.             }
  621.             lappend savestr $sv
  622.             set tmp [string range $tmp [lindex $str 1] end]
  623.             incr st [lindex $str 1]
  624.         }
  625.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  626.     }
  627.     if {$isDoc} {
  628.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  629.         set text2 [string range $text [expr $pos - $start] end]
  630.     } else {
  631.         set text1 $text
  632.     }        
  633.     foreach char $entitylist {
  634.         set schar [string range $char 1 [expr [string length $char] - 2]]
  635.         if {[info exists htmlCharacterSpecial($schar)]} {
  636.             set rtext "$htmlCharacterSpecial($schar)"
  637.         } elseif {[info exists htmlCapCharacterSpecial($schar)]} {
  638.             set rtext "$htmlCapCharacterSpecial($schar)"
  639.         } elseif {$schar == "#161"} {
  640.             set rtext ¡
  641.         } elseif {$schar == "#191"} {
  642.             set rtext ¿
  643.         } elseif {$schar == "amp"} {
  644.             set rtext "\\&"
  645.         } elseif {$schar == "lt"} {
  646.             set rtext "<"
  647.         } elseif {$schar == "gt"} {
  648.             set rtext ">"
  649.         }
  650.         
  651.         set subNum [regsub -all $char $text1 $rtext text1]
  652.         incr subs1 [expr $subNum * ([string length $char] - 1)]
  653.         incr lett $subNum
  654.         if {$isDoc} {
  655.             incr lett [regsub -all $char $text2 $rtext text2]
  656.         }
  657.         
  658.     }
  659.     set text $text1
  660.     if {$isDoc} {append text $text2}
  661.     if {$lett} {
  662.         if {[info exists savestr]} {
  663.             set i 0
  664.             set tmp ""
  665.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  666.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  667.                 append tmp [lindex $savestr $i]
  668.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  669.                 incr i
  670.             }
  671.             set text "$tmp$text"
  672.         }
  673.         replaceText $start $end $text
  674.         if {$isDoc} {
  675.             goto [expr $upos - $subs1]
  676.         } else {
  677.             set end [getPos]
  678.             select $start $end
  679.         }
  680.     }
  681.     message "$lett characters translated in $messageString."
  682. }
  683.  
  684.  
  685. #===============================================================================
  686. # HTML character entities
  687. #===============================================================================
  688.  
  689. proc htmlAddCommonChars {} {
  690.     global modifiedModeVars HTMLmodeVars htmlSpecialCharacter htmlCapCharSpecMenu
  691.     global htmlSpecialSymbCharacter
  692.     set commonChars $HTMLmodeVars(commonChars)
  693.  
  694.     set htmlCharacters [lsort [array names htmlSpecialCharacter]]
  695.     set htmlCapCharacters [lsort [array names htmlCapCharSpecMenu]]
  696.     set htmlSymbCharacters [lsort [array names htmlSpecialSymbCharacter]]
  697.     set htmlAllCharacters [concat $htmlCharacters $htmlCapCharacters $htmlSymbCharacters]
  698.     if {![catch {listpick -l -p "Select chars for the commonly used char list" \
  699.                 $htmlAllCharacters} newchars]} {
  700.         set dirty 0
  701.         foreach c $newchars {
  702.             if {[lsearch -exact $commonChars $c] < 0} {
  703.                 set dirty 1
  704.                 set commonChars [lsort [lappend commonChars $c]]
  705.             }
  706.         }
  707.         if {$dirty} {
  708.             lappend modifiedModeVars {commonChars HTMLmodeVars}
  709.             set HTMLmodeVars(commonChars) $commonChars
  710.             htmlRebuildMenu "Rebuiding HTML menu…"
  711.             message "New characters added to the common list."
  712.         }
  713.     }
  714. }
  715.  
  716. proc htmlDefaultCommonChars {} {
  717.     global modifiedModeVars HTMLmodeVars
  718.     
  719.     if {[askyesno "Revert to default common characters?"] == "yes"} {
  720.         set HTMLmodeVars(commonChars) $HTMLmodeVars(defaultCommonChars)
  721.         lappend modifiedModeVars {commonChars HTMLmodeVars}
  722.         htmlRebuildMenu "Rebuiding HTML menu…"
  723.         message "Common character list reverted to default."
  724.     }    
  725. }
  726.  
  727. proc htmlClearCommonChars {} {
  728.     global modifiedModeVars HTMLmodeVars
  729.     
  730.     if {[askyesno "Remove all common characters?"] == "yes"} {
  731.         set HTMLmodeVars(commonChars) {}
  732.         lappend modifiedModeVars {commonChars HTMLmodeVars}
  733.         htmlRebuildMenu "Rebuiding HTML menu…"
  734.         message "Common character list cleared."
  735.     }    
  736. }
  737.  
  738. #
  739. # Insert special character entity
  740. #
  741. proc htmlInsertCharacter {char} {
  742.     global htmlSpecialCharacter htmlCapCharSpecMenu htmlSpecialSymbCharacter
  743.     if {[isSelection]} { deleteSelection }
  744.     foreach c [list SpecialCharacter CapCharSpecMenu SpecialSymbCharacter] {
  745.         if {[info exists html${c}($char)]} {
  746.             insertText &[set html${c}($char)]\;
  747.         }
  748.     }
  749. }
  750.  
  751.  
  752.  
  753. #===============================================================================
  754. # General Commands
  755. #===============================================================================
  756.  
  757. # remove containing tags
  758. proc htmlUntagandSelect {} {htmlUntag 1}
  759.  
  760. proc htmlUntag {{selectit 0}} {
  761.     set curPos [getPos]
  762.     set tags [htmlGetContainer $curPos [selEnd]]
  763.     if {[llength $tags] < 5} {
  764.         alertnote "Cannot decide on enclosing tags."
  765.         return
  766.     }
  767.     # delete them
  768.     replaceText [lindex $tags 0] [lindex $tags 3] \
  769.     [getText [lindex $tags 1] [lindex $tags 2]]
  770.     if {$selectit} {
  771.         select [lindex $tags 0] \
  772.             [expr [lindex $tags 2] - [lindex $tags 1] + [lindex $tags 0]]
  773.     } else {
  774.         if {$curPos < [lindex $tags 1]} {set curPos [lindex $tags 1]}
  775.         if {$curPos > [lindex $tags 2]} {set curPos [lindex $tags 2]}
  776.         goto [expr $curPos - [lindex $tags 1] + [lindex $tags 0]]
  777.     }
  778.     message "[lindex $tags 4] deleted."
  779. }
  780.  
  781. # select container, like Balance (cmd-B)
  782. proc htmlSelectinContainer {} {htmlSelectContainer 1}
  783.  
  784. proc htmlSelectContainer {{inside 0}} {
  785.     set start [getPos]
  786.     if {$start != 0 &&
  787.             ![catch {getText $start [expr $start + 2]} lookingAt] &&
  788.             $lookingAt != "</" &&
  789.             [string range $lookingAt 0 0] == "<"} {
  790.         incr start -1
  791.     }
  792.     set tags [htmlGetContainer $start [selEnd]]
  793.     if {[llength $tags] == 5} {
  794.         if {$inside} {
  795.             select [lindex $tags 1] [lindex $tags 2]
  796.         } else {
  797.             select [lindex $tags 0] [lindex $tags 3]
  798.         }
  799.         message "[lindex $tags 4] selected."
  800.     } else {
  801.         beep
  802.         message "Cannot decide on enclosing tags."
  803.     }
  804. }
  805.  
  806. # Select an opening tag, or remove it, of an element without a closing tag.
  807. proc htmlRemoveOpening {} {htmlSelectOpening 1}
  808.  
  809. proc htmlSelectOpening {{remove 0}} {
  810.     set begin [getPos]
  811.     # back up one if possible and selection is wanted.
  812.     if {$begin >0 && !$remove} {incr begin -1}
  813.     set tag [htmlGetOpening $begin]
  814.     if {[llength $tag] == 3} {
  815.         if {$remove} {
  816.             deleteText [lindex $tag 0] [lindex $tag 1]
  817.             if {$begin < [lindex $tag 1]} {set begin [lindex $tag 1]}
  818.             goto [expr $begin - [lindex $tag 1] + [lindex $tag 0]]
  819.             message "[lindex $tag 2] deleted."
  820.         } else {
  821.             select [lindex $tag 0] [lindex $tag 1]
  822.             message "[lindex $tag 2] selected."
  823.         }
  824.     } else {
  825.         if {$remove} {
  826.             alertnote "Cannot find opening tag."
  827.         } else {
  828.             beep
  829.             message "Cannot find opening tag."
  830.         }
  831.     }
  832. }
  833.  
  834. # Called by cmd-double-click.
  835. # Change attributes if click on a tag.
  836. proc htmlChangeDblClick {} {
  837.     set pos [getPos]
  838.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  839.     [lindex $res 1] < $pos} {return}
  840.     set txt [getText [expr [lindex $res 0] + 1] [expr [lindex $res 1] - 1]]
  841.     if {[string index [set tag [lindex $txt 0]] 0] == "/" || $tag == "!--"} {return}
  842.     if {[set newTag [htmlChangeElement $txt [string toupper $tag] [lindex $res 0]]] != ""} {
  843.         replaceText [lindex $res 0] [lindex $res 1] $newTag
  844.     }
  845. }
  846.  
  847. # Change an existing element.
  848. proc htmlChangeContainer {} {
  849.     set tag [htmlGetContainer [getPos] [selEnd]]
  850.     if {[llength $tag] == 5} {
  851.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  852.         [expr [lindex $tag 1] - 1]] [lindex $tag 4] [lindex $tag 0]]
  853.         if {[string length $newTag]} {
  854.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  855.         }
  856.     } else {
  857.         alertnote "Cannot decide on enclosing tags."
  858.     }
  859. }
  860.  
  861. proc htmlChangeOpening {} {
  862.     set tag [htmlGetOpening [getPos]]
  863.     if {[llength $tag] == 3} {
  864.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  865.         [expr [lindex $tag 1] - 1]] [lindex $tag 2] [lindex $tag 0]]
  866.         if {[string length $newTag]} {
  867.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  868.         }
  869.     } else {
  870.         alertnote "Cannot find opening tag."
  871.     }
  872. }
  873.  
  874. #
  875. # Exstracts all attributes to a element from a list, and puts up a dialog window
  876. # where the user can change the attributes.
  877. #
  878. proc htmlChangeElement {tag elem {wrPos 0}} {
  879.     global htmlColorAttr htmlURLAttr HTMLmodeVars
  880.     global htmluserColorname htmlColorNumber htmlPackageToUse
  881.     global htmlElemAttrOptional1 htmlElemAttrOptional3
  882.     global htmlElemEventHandler1 htmlWindowAttr htmlPlugins
  883.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  884.  
  885.     # Remove tabs and returns from list.
  886.     regsub -all "\[\t\r\]+" $tag " " tag
  887.     
  888.     # Remove element name.
  889.     set tagelem [lindex $tag 0]
  890.     set tag [string range $tag [string length $tagelem] end]
  891.     set attrs ""
  892.     set attrVals ""
  893.     
  894.     # Exstract the attributes.
  895.     while {[regexp {[ ]+([^ "]+"[^"]*"|[^ "]+)} $tag thisatt]} {
  896.         set tag [string range $tag [string length $thisatt] end]
  897.         set thisatt [htmlRemoveQuotes $thisatt]
  898.         lappend attrs [string trim [lindex $thisatt 0]]
  899.         lappend attrVals [lindex $thisatt 1]
  900.     }    
  901.     
  902.     # All INPUT elements are defined differently. Must extract TYPE.
  903.     if {$elem == "INPUT"} {
  904.         set typeIndex [lsearch -exact [string toupper $attrs] "TYPE="]
  905.         if {$typeIndex >= 0 } {
  906.             set elem [string toupper [lindex $attrVals $typeIndex]]
  907.             # Remove TYPE attribute from list.
  908.             set attrs [lreplace $attrs $typeIndex $typeIndex]
  909.             set attrVals [lreplace $attrVals $typeIndex $typeIndex]
  910.             set used "INPUT TYPE=\"${elem}\""
  911.         } else {
  912.             beep 
  913.             message "INPUT element without a TYPE attribute."
  914.             return
  915.         } 
  916.     } else {
  917.         set used $elem
  918.     }
  919.     
  920.     # If EMBED element, choose which
  921.     if {$elem == "EMBED" && $htmlPackageToUse == 1} {
  922.         if {[catch {listpick -p "Which plug-in?" [lsort $htmlPlugins]} elem] || ![string length $elem]} {return}
  923.     }
  924.     
  925.     # If LI element, check in which list.
  926.     if {$elem == "LI"} {
  927.         set ltype [htmlFindList]
  928.         if {$ltype == "UL"} {
  929.             set elem "LI IN UL"
  930.         } elseif {$ltype == "OL"} {
  931.             set elem "LI IN OL"
  932.         }            
  933.     }
  934.     
  935.     set eventText ""
  936.     
  937.     # JavaScript event handlers. Extension package only.
  938.     set eventHandler [string toupper [htmlGetEvent $elem]]
  939.  
  940.     # Remove event handler from attributes list,
  941.     # if they should not be included, and save them to put them back later.
  942.     set attrsToupper [string toupper $attrs]
  943.     if {!$HTMLmodeVars(inclEventHandler)} {
  944.         foreach ev $eventHandler {
  945.             set evIndex [lsearch -exact $attrsToupper $ev]
  946.             if {$evIndex >=0} {
  947.                 append eventText " " [lindex $attrs $evIndex] \
  948.                 [htmlAddQuotes [lindex $attrVals $evIndex]]
  949.                 set attrs [lreplace $attrs $evIndex $evIndex]
  950.                 set attrVals [lreplace $attrVals $evIndex $evIndex]
  951.                 set attrsToupper [lreplace $attrsToupper $evIndex $evIndex]
  952.             }
  953.         }
  954.     }
  955.     
  956.     set attrs $attrsToupper
  957.         
  958.     # Element known by HTML mode?
  959.     if {![info exists htmlElemAttrOptional${htmlPackageToUse}($elem)]} {
  960.         alertnote "Unknown element: $elem"
  961.         return
  962.     }
  963.     
  964.     set useBig $HTMLmodeVars(changeInBigWindows)
  965.     set optatts [htmlGetOptional $elem]
  966.     set alloptatts [htmlGetOptional $elem 1]
  967.     set reqatts [htmlGetRequired $elem]
  968.     if {$HTMLmodeVars(useAttsApplyToDialogs) || !$useBig} {
  969.         set allAttrs [htmlGetUsed $elem $reqatts $optatts]
  970.     } else {
  971.         set allAttrs [concat $reqatts $optatts]
  972.     }
  973.     set reallyAllAtts [concat $reqatts $alloptatts]
  974.     
  975.     set choices [htmlGetChoices $elem]
  976.     set numAttrs [htmlGetNumber $elem]
  977.     
  978.     set errText ""
  979.     
  980.     # Check if there are some unknown attributes.
  981.     set notUsedAtts ""
  982.     foreach a $optatts {
  983.         if {[lsearch -exact $allAttrs $a] < 0} {
  984.             lappend notUsedAtts $a
  985.         }
  986.     }
  987.     set hiddenAtts ""
  988.     foreach a $alloptatts {
  989.         if {[lsearch -exact $optatts $a] < 0} {
  990.             lappend hiddenAtts $a
  991.         }
  992.     }
  993.     # First check if one which is normally not used is used.
  994.     set addNotUsed 0
  995.     foreach a $attrs {
  996.         if {[lsearch -exact $allAttrs $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  997.             append allAttrs " $notUsedAtts"
  998.             set addNotUsed 1
  999.             break
  1000.         }
  1001.     }
  1002.     # then check some hidden one is used
  1003.     set addHidden 0
  1004.     foreach a $attrs {
  1005.         if {[lsearch -exact $allAttrs $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  1006.             append allAttrs " $hiddenAtts"
  1007.             set addHidden 1
  1008.             break
  1009.         }
  1010.     }
  1011.     # Add event handlers.
  1012.     if {[string length $eventHandler]} {append allAttrs " " $eventHandler}
  1013.     
  1014.     # finally check if some is unknown
  1015.     foreach a $attrs {
  1016.         if {[lsearch -exact $allAttrs $a] < 0} {
  1017.             lappend errText "Unknown attribute: $a"
  1018.         }
  1019.     }
  1020.  
  1021.     # Does this element have any attributes?
  1022.     if {![llength $reallyAllAtts]} {
  1023.         if {[llength $errText]} {
  1024.             if {[askyesno "$elem has no attributes. Remove the ones in the text?"] == "no"} {
  1025.                 return
  1026.             } else {
  1027.                 return [htmlSetCase <$elem>]
  1028.             }
  1029.         } else {
  1030.             beep
  1031.             message "$elem has no attributes."
  1032.             return
  1033.         }
  1034.     }
  1035.     
  1036.     # Add something if all attrs are hidden.
  1037.     if {![llength $allAttrs]} {
  1038.         if {[llength $notUsedAtts]} {
  1039.             set allAttrs $notUsedAtts
  1040.             set addNotUsed 1
  1041.         } else {
  1042.             set allAttrs $hiddenAtts
  1043.             set addNotUsed 1
  1044.             set addHidden 1
  1045.         }
  1046.     } 
  1047.     
  1048.     set values ""
  1049.     # Add two dummy elements for OK and Cancel buttons.
  1050.     if {$useBig} {set values {0 0}}
  1051.  
  1052.     # Build a list with attribute vales.
  1053.     foreach a $allAttrs {
  1054.         set attrIndex [lsearch -exact $attrs $a]
  1055.         if {$attrIndex >= 0 } {set aval [lindex $attrVals $attrIndex]}
  1056.         set a2 [string trimright $a =]
  1057.         if {[string index $a [expr [string length $a] - 1]] != "="} {
  1058.             # Flag
  1059.             if {$attrIndex >= 0} {
  1060.                 lappend values 1
  1061.             } else {
  1062.                 lappend values 0
  1063.             } 
  1064.         } elseif {([lsearch -exact $htmlURLAttr $a] >= 0 && [lsearch -exact $htmlSpecURL "${elem}!=$a2"] < 0) || \
  1065.             [lsearch -exact $htmlSpecURL "${elem}=$a2"] >= 0} {
  1066.                 # URL
  1067.             if {$attrIndex >= 0} {
  1068.                 set aval [htmlURLunEscape $aval]
  1069.                 htmlAddToCache URLs $aval
  1070.                 if {$useBig} {
  1071.                     lappend values "" $aval 0
  1072.                 } else {
  1073.                     lappend values $aval
  1074.                 }
  1075.             } else {
  1076.                 if {$useBig} {
  1077.                     lappend values "" "No value" 0
  1078.                 } else {
  1079.                     lappend values ""
  1080.                 }
  1081.             }
  1082.         } elseif {([lsearch -exact $htmlColorAttr $a] >= 0 && [lsearch -exact $htmlSpecColor "${elem}!=$a2"] < 0) || \
  1083.         [lsearch -exact $htmlSpecColor "${elem}=$a2"] >= 0} {
  1084.             # Color
  1085.             if {$attrIndex >= 0} {
  1086.                 set aval [htmlCheckColorNumber $aval]
  1087.                 if {$aval == 0} {
  1088.                     lappend errText "$a: Invalid color number."
  1089.                     if {$useBig} {
  1090.                         lappend values "" "No value" 0
  1091.                     } else {
  1092.                         lappend values ""
  1093.                     }
  1094.                 } elseif {[info exists htmluserColorname($aval)]} {
  1095.                     if {$useBig} {
  1096.                         lappend values "" $htmluserColorname($aval) 0
  1097.                     } else {
  1098.                         lappend values $htmluserColorname($aval)
  1099.                     }
  1100.                 } elseif {[info exists htmlColorNumber($aval)]} {
  1101.                     if {$useBig} {
  1102.                         lappend values "" $htmlColorNumber($aval) 0
  1103.                     } else {
  1104.                         lappend values $htmlColorNumber($aval)
  1105.                     }
  1106.                 } else {
  1107.                     if {$useBig} {
  1108.                         lappend values $aval "No value" 0
  1109.                     } else {
  1110.                         lappend values $aval
  1111.                     }
  1112.                 }
  1113.             } else {
  1114.                 if {$useBig} {
  1115.                     lappend values "" "No value" 0
  1116.                 } else {
  1117.                     lappend values ""
  1118.                 }
  1119.             }
  1120.         } elseif {([lsearch -exact $htmlWindowAttr $a] >= 0 && [lsearch -exact $htmlSpecWindow "${elem}!=$a2"] < 0) || \
  1121.         [lsearch -exact $htmlSpecWindow "${elem}=$a2"] >= 0} {
  1122.             # Window
  1123.             if {$attrIndex >= 0} {
  1124.                 htmlAddToCache windows $aval
  1125.                 if {$useBig} {
  1126.                     lappend values "" $aval
  1127.                 } else {
  1128.                     lappend values $aval
  1129.                 }
  1130.             } else {
  1131.                 if {$useBig} {
  1132.                     lappend values "" "No value"
  1133.                 } else {
  1134.                     lappend values ""
  1135.                 }
  1136.             }
  1137.         } elseif {[lsearch $numAttrs "${a}*"] >= 0} {
  1138.             # Number
  1139.             if {$attrIndex >= 0} {
  1140.                 set numcheck [htmlCheckAttrNumber $elem $a $aval]
  1141.                 if {$numcheck == 1} {
  1142.                     lappend values $aval
  1143.                 } else {
  1144.                     lappend errText "$a: $numcheck"
  1145.                     lappend values ""
  1146.                 }
  1147.             } else {
  1148.                 lappend values ""
  1149.             }
  1150.         } elseif {[lsearch $choices "${a}*"] >= 0} {
  1151.             # Choices
  1152.             if {$attrIndex >= 0} {
  1153.                 set match ""
  1154.                 if {!(($elem == "OL" || $elem == "LI IN OL") && $a == "TYPE=")} {
  1155.                     set aval [string toupper $aval]
  1156.                 }
  1157.                 foreach w $choices {
  1158.                     if {$w == "${a}${aval}"} {
  1159.                         set match $aval
  1160.                     }
  1161.                 }
  1162.                 if {[string length $match]} {
  1163.                     lappend values $match
  1164.                 } else {
  1165.                     lappend errText "$a: Unknown choice, $aval."
  1166.                     lappend values ""
  1167.                 }
  1168.             } else {
  1169.                 lappend values ""
  1170.             }    
  1171.         } elseif {$attrIndex >= 0} {
  1172.             # Any other
  1173.             lappend values $aval
  1174.         } else {
  1175.             lappend values ""
  1176.         }
  1177.     }
  1178.     # If invalid attributes, continue?
  1179.     if {[llength $errText] && ![htmlErrorWindow "$elem not well-defined" $errText 1]} {
  1180.         return 
  1181.     }
  1182.     if {$useBig} {
  1183.         set r [htmlOpenElemWindow $used $elem [lindex [posToRowCol $wrPos] 1] $values $addNotUsed $addHidden $wrPos]
  1184.     } else {
  1185.         set r [htmlOpenElemStatusBar $used $elem [lindex [posToRowCol $wrPos] 1] $values $addNotUsed $addHidden $wrPos]
  1186.     }
  1187.     # Put back event handlers. Empty string means "Cancel", do nothing.
  1188.     if {[string length $r]} {
  1189.         set r "[string range $r 0 [expr [string length $r] - 2]]$eventText>"
  1190.     }
  1191.     return $r
  1192. }
  1193.  
  1194. # Removes all tags in a selection or the whole document.
  1195. proc htmlRemoveTags {} {
  1196.     if {![isSelection]} {
  1197.         if {[set ync [askyesno -c "Put text without tags in a new window?"]] == "cancel"} {return}
  1198.         set txt [htmlTagStrip [getText 0 [maxPos]]]
  1199.         if {$ync == "yes"} {
  1200.             new
  1201.             insertText $txt
  1202.         } else {
  1203.             replaceText 0 [maxPos] $txt
  1204.         }
  1205.     } else {
  1206.         replaceText [getPos] [selEnd] [htmlTagStrip [getSelect]]
  1207.     }
  1208. }
  1209.  
  1210. # Put quotes around all attributes
  1211. proc htmlQuoteAllAttributes {} {
  1212.     set pos [getPos]
  1213.     if {[isSelection]} {
  1214.         set start [getPos]
  1215.         set end [selEnd]
  1216.     } else {
  1217.         set start 0
  1218.         set end [maxPos]
  1219.     }
  1220.     set text [getText $start $end]
  1221.     while {[regexp -indices {<!--|<[^<>]+>} $text tag]} {
  1222.         append newtext [string range $text 0 [lindex $tag 0]]
  1223.         set this [string range $text [expr [lindex $tag 0] + 1] [lindex $tag 1]]
  1224.         set text [string range $text [expr [lindex $tag 1] + 1] end]
  1225.         if {$this == "!--"} {
  1226.             if {[regexp -indices -- {-->} $text commend]} {
  1227.                 append newtext $this[string range $text 0 [lindex $commend 1]]
  1228.                 set text [string range $text [expr [lindex $commend 1] + 1] end]
  1229.             } else {
  1230.                 append newtext $text
  1231.                 set text ""
  1232.             }
  1233.         } else {
  1234.             regsub -all "(\[ \t\r\]+\[^=\]+=)(\[^ >\"\t\r\]+)" $this {\1"\2"} newtag
  1235.             append newtext $newtag
  1236.         }
  1237.     }
  1238.     append newtext $text
  1239.     replaceText $start $end $newtext
  1240.     goto $pos
  1241. }
  1242.  
  1243. # opens the manual in the browser.
  1244. proc htmlHelp {} {
  1245.     global HOME HTMLmodeVars modifiedModeVars browserSig
  1246.     switch $HTMLmodeVars(manualStartPage) {
  1247.         0 {set start HTMLmanual.html}
  1248.         1 {set start text:TableOfContents.html}
  1249.         2 {set start text:HTMLmanualFrames.html}
  1250.     }
  1251.     set path "$HTMLmodeVars(manualFolder):$start"
  1252.     if {![file exists $path]} {
  1253.         if {![catch {htmlGetDir "Locate manual"} folder]} {
  1254.             set path "$folder:$start"
  1255.             if {![file exists $path]} {
  1256.                 alertnote "Folder doesn't contain the HTML manual."
  1257.                 return
  1258.             }
  1259.             set HTMLmodeVars(manualFolder) $folder
  1260.             lappend modifiedModeVars {manualFolder HTMLmodeVars}
  1261.         } else {
  1262.             return
  1263.         }
  1264.     }
  1265.     htmlSendWindow $path
  1266.      if {!$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1267. }
  1268.  
  1269. #
  1270. # launch a viewer and pass this window to it
  1271. #
  1272. proc htmlSendWindow {{path ""}} {
  1273.     global HTMLmodeVars browserSig
  1274.  
  1275.     if {$path == ""} {
  1276.         set path [stripNameCount [win::Current]]
  1277.  
  1278.         if {[winDirty]} {
  1279.             if {$HTMLmodeVars(saveWithoutAsking) || [set ask [askyesno -c "Save '[file tail $path]'?"]] == "yes"} {
  1280.                 save
  1281.             } elseif {$ask == "cancel"} {
  1282.                 return
  1283.             } elseif {![file exists $path]} {
  1284.                 alertnote "Can't send window to browser."
  1285.                 return
  1286.             }
  1287.         }
  1288.         # Get path again, in case it was Untitled before.
  1289.         set path [stripNameCount [win::Current]]
  1290.     }
  1291.     if {![info exists browserSig] && [catch {getFileSig [icGetPref -t 1 Helper•http]} browserSig]} {set browserSig MOSS}
  1292.     if {![htmlCheckRunning $browserSig] && [catch {app::launchBack $browserSig}]} {
  1293.         getApplSig "Please locate your web browser" browserSig
  1294.         app::launchBack $browserSig
  1295.     }
  1296.     
  1297.     # MSIE opens the file in a new window unless an open URL event is used.
  1298.     # Cyberdog opens the text file unless an open URL event is used.
  1299.     if {$browserSig == "MSIE" || $browserSig == "dogz"} {
  1300.         set path [htmlURLescape $path 1]
  1301.         regsub -all : $path / path
  1302.         set flgs ""
  1303.         if {$browserSig == "MSIE"} {set flgs "FLGS 1"}
  1304.         eval AEBuild '$browserSig' WWW! OURL "----" "“file:///$path”" $flgs
  1305.     } else {
  1306.         sendOpenEvent noReply '$browserSig' $path
  1307.     }
  1308.      if {$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1309. }
  1310.  
  1311. #===============================================================================
  1312. # Caches
  1313. #===============================================================================
  1314.  
  1315.  
  1316. proc htmlCleanUpCache {cache} {
  1317.     global HTMLmodeVars 
  1318.     global modifiedModeVars
  1319.     
  1320.     set URLs $HTMLmodeVars($cache)
  1321.  
  1322.     if {![llength $URLs]} {
  1323.         alertnote "No $cache are cached."
  1324.         return
  1325.     }
  1326.     set urlnumber [llength $URLs]
  1327.     set screenHeight [lindex [getMainDevice] 3]
  1328.     set maxLines [expr ($screenHeight - 160) / 20]
  1329.     set pages [expr ($urlnumber - 1) / $maxLines ]
  1330.     set thispage 0
  1331.     for {set i 0} {$i < $urlnumber} {incr i} {
  1332.         lappend URLsToSave 1
  1333.     }
  1334.     set thisbox $URLsToSave
  1335.     while {1} {
  1336.         if {$thispage < $pages} {
  1337.             set thisurlnumber $maxLines
  1338.         } else {
  1339.             set thisurlnumber [expr ($urlnumber - 1 ) % $maxLines + 1]
  1340.         }
  1341.         set height [expr 75 + $thisurlnumber  * 20]
  1342.         set box "-w 440 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1343.             -b Cancel 100 [expr $height - 30] 165 [expr $height - 10] \
  1344.             -b {Uncheck all} 180 [expr $height - 30] 265 [expr $height - 10] \
  1345.             -t {Uncheck the $cache you want to remove} 10 10 440 30 "
  1346.         if {$thispage < $pages} {
  1347.             lappend box -b "More…" 280 [expr $height - 30] 345 [expr $height - 10]
  1348.         }
  1349.         if {$thispage > 0} {
  1350.             lappend box -b "Back…" 360 [expr $height - 30] 425 [expr $height - 10]
  1351.         }
  1352.  
  1353.         set hpos 30 
  1354.         set thisURLs [lrange $URLs [expr $thispage * $maxLines] \
  1355.         [expr $thispage * $maxLines + $maxLines - 1]]
  1356.         set i 0
  1357.         foreach url $thisURLs {
  1358.             lappend box -c $url [lindex $thisbox $i] 10 $hpos 430 [expr $hpos + 15]
  1359.             incr i
  1360.             incr hpos 20
  1361.         }
  1362.         set thisbox [eval [concat dialog $box]]
  1363.         if {[lindex $thisbox 1]} {
  1364.             # cancel
  1365.             return
  1366.         } elseif {[lindex $thisbox 2]} {
  1367.             # uncheck all
  1368.             set thisbox {}
  1369.             for {set i 0} {$i < [llength $thisbox]} {incr i} {
  1370.                 lappend thisbox 0
  1371.             }
  1372.         } else {
  1373.             if {$pages == 0} {
  1374.                 set ll 3
  1375.             } elseif {$thispage == 0 || $thispage == $pages} {
  1376.                 set ll 4
  1377.             } else {
  1378.                 set ll 5
  1379.             }
  1380.             set URLsToSave [eval [concat lreplace [list $URLsToSave] [expr $thispage * $maxLines] \
  1381.             [expr $thispage * $maxLines + $maxLines - 1] [lrange $thisbox $ll end]]]
  1382.             if {[lindex $thisbox 0]} { 
  1383.                 # OK
  1384.                 break
  1385.             } elseif {$thispage < $pages && [lindex $thisbox 3]} { 
  1386.                 # more
  1387.                 incr thispage 1
  1388.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1389.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1390.             } else {
  1391.                 # back
  1392.                 incr thispage -1
  1393.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1394.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1395.             }
  1396.         }
  1397.     }
  1398.     set newurls {}
  1399.     for {set i 0} {$i < $urlnumber} {incr i} {
  1400.         if {[lindex $URLsToSave $i]} {
  1401.             lappend newurls [lindex $URLs $i]
  1402.         }
  1403.     }
  1404.     set HTMLmodeVars($cache) $newurls
  1405.     lappend modifiedModeVars [list $cache HTMLmodeVars]
  1406.     if {![llength $newurls]} {htmlEnable$cache off}
  1407. }
  1408.  
  1409. proc htmlSelScrapToURL {sel msg1 msg2} {
  1410.     set newurl [htmlURLunEscape [string trim [eval get$sel]]]
  1411.     # Convert tabs and returns.
  1412.     if {[regexp {[\t\r\n]} $newurl]} {
  1413.         alertnote "$msg1 contains tabs or returns. It will not be added to the URL cache."
  1414.         return
  1415.     }
  1416.     if {[string length $newurl]} {
  1417.         htmlAddToCache URLs $newurl
  1418.         message "$newurl added to URLs."
  1419.     } else {
  1420.         beep
  1421.         message $msg2
  1422.     }
  1423. }
  1424.  
  1425. proc htmlAddSelection {} {
  1426.     htmlSelScrapToURL Select Selection "No selection!"
  1427. }
  1428.  
  1429. proc htmlAddClipboard {} {
  1430.     htmlSelScrapToURL Scrap Clipboard "Clipboard empty!"
  1431. }
  1432.  
  1433. proc htmlClearCache {cache} {
  1434.     global HTMLmodeVars modifiedModeVars
  1435.     if {[askyesno "Remove all $cache from [string range $cache 0 [expr [string length $cache] - 2]] cache?"] == "yes"} {
  1436.         set HTMLmodeVars($cache) {}
  1437.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  1438.         htmlEnable$cache off
  1439.     }
  1440. }
  1441.  
  1442. # Imports all URLs in a file to the cache.
  1443. proc htmlImport {} {
  1444.     global HTMLmodeVars modifiedModeVars htmlURLAttr
  1445.     set urls $HTMLmodeVars(URLs)
  1446.  
  1447.     if {[catch {getfile "Import URLs from:"} fil] || ![htmlIsTextFile $fil alertnote]} {return}
  1448.     set fid [open $fil r]
  1449.     set filecont " [read $fid]"
  1450.     close $fid
  1451.     if {[llength $urls]} {
  1452.         set cl [askyesno -c "Clear URL cache before importing?"]
  1453.         if {$cl == "cancel"} {
  1454.             return
  1455.         } elseif {$cl == "yes"} {
  1456.             set urls {}
  1457.         }
  1458.     }
  1459.             
  1460.     set exp1 "\[ \\t\\n\\r\]+("
  1461.     foreach attr $htmlURLAttr {
  1462.         append exp1 "$attr|"
  1463.     }
  1464.     set exp1 [string trimright $exp1 |]
  1465.     append exp1 ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  1466.     set exp2 {[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  1467.     for {set i1 1} {$i1 < 3} {incr i1} {
  1468.         set fcont $filecont
  1469.         set exp [set exp$i1]
  1470.         while {[regexp -nocase -indices $exp $fcont a b url]} {
  1471.             set link [htmlURLunEscape [string trim [string range $fcont [lindex $url 0] [lindex $url 1]] \"]]
  1472.             set fcont [string range $fcont [lindex $url 1] end]
  1473.             if {[lsearch -exact $urls $link] < 0} {
  1474.                 lappend urls  $link
  1475.             }
  1476.         }
  1477.     }
  1478.     set HTMLmodeVars(URLs) [lsort $urls]
  1479.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1480.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1481.     message "URLs imported."
  1482. }
  1483.  
  1484. # Export URLs in cache to a file.
  1485. proc htmlExport {} {
  1486.     global HTMLmodeVars
  1487.     if {![llength $HTMLmodeVars(URLs)]} {
  1488.         alertnote "URL cache is empty."
  1489.         return
  1490.     }
  1491.     foreach url $HTMLmodeVars(URLs) {
  1492.         lappend out "HREF=\"$url\""
  1493.     }
  1494.     if {![catch {putfile "Export URL cache to:" "URL cache"} fil]} {
  1495.         if {[file exists $fil]} {removeFile $fil}
  1496.         set fid [open $fil w]
  1497.         puts $fid [join $out "\n"]
  1498.         close $fid
  1499.         message "URLs exported."
  1500.     }
  1501. }
  1502.  
  1503. # Add all files in a folder to URL cache.
  1504. proc htmlAddFolder {} {
  1505.     global HTMLmodeVars modifiedModeVars
  1506.     if {[catch {htmlGetDir "Folder to cache:"} folder]} {return}
  1507.     set path ""
  1508.     foreach hp $HTMLmodeVars(homePages) {
  1509.         if {[string match "[lindex $hp 0]:*" "$folder:"]} {
  1510.             set path [string range $folder [expr [string length [lindex $hp 0]] +1] end]
  1511.             regsub -all {:} $path {/} path
  1512.             if {[string length $path]} {append path /}
  1513.         }
  1514.     }
  1515.     set val [dialog -w 350 -h 80 -t "Path:" 10 10 60 30 -e $path 70 10 340 25 \
  1516.     -b OK 20 50 85 70 -b Cancel 110 50 175 70]
  1517.     if {[lindex $val 2]} {return}
  1518.     set path [string trim [lindex $val 0]]
  1519.     if {[string length $path]} {set path "[string trimright $path /]/"}
  1520.     set urls $HTMLmodeVars(URLs)
  1521.     if {[llength $urls]} {
  1522.         set cl [askyesno -c "Clear URL cache first?"]
  1523.         if {$cl == "cancel"} {
  1524.             return
  1525.         } elseif {$cl == "yes"} {
  1526.             set urls {}
  1527.         }
  1528.     }
  1529.  
  1530.     foreach fil [glob -nocomplain "$folder:*"] {
  1531.         set name [file tail $fil]
  1532.         if {![file isdirectory $fil] && [lsearch -exact $urls "$path$name"] < 0} {
  1533.             lappend urls "$path$name"
  1534.         }
  1535.     }
  1536.     set HTMLmodeVars(URLs) [lsort $urls]
  1537.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1538.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1539.     message "Files added to URL cache."
  1540. }
  1541.  
  1542.  
  1543. #===============================================================================
  1544. #  Footers
  1545. #===============================================================================
  1546.  
  1547. proc htmlFooters {} {
  1548.     global HTMLmodeVars modifiedModeVars
  1549.     
  1550.     set footers [lsort $HTMLmodeVars(footers)]
  1551.     set touchedIt 0
  1552.     set this ∞
  1553.     while {1} {
  1554.         set box "-t {Footers:} 10 10 80 30 \
  1555.         -t Path: 30 50 80 70 \
  1556.         -b OK 10 110 75 130 -b Cancel 90 110 155 130 -b New… 170 110 235 130"
  1557.         if {[llength $footers]} {
  1558.             set foot ""
  1559.             foreach f $footers {
  1560.                 lappend foot [file tail $f]
  1561.             }
  1562.             append box " -m [list [concat [list $this] $foot]] 90 10 440 30"
  1563.             append box " -b Remove 250 110 315 130 -b Insert 330 110 395 130"
  1564.             foreach f $footers {
  1565.                 lappend box -n [file tail $f] -t $f 90 50 440 90
  1566.             }
  1567.         } else {
  1568.             append box  " -m {{None defined} {None defined}} 90 10 440 30"
  1569.         }
  1570.         set values [eval [concat dialog -w 450 -h 140 $box]]
  1571.         set this [lindex $values 3]
  1572.         if {[lindex $values 0]} {
  1573.             set HTMLmodeVars(footers) $footers
  1574.             lappend modifiedModeVars {footers HTMLmodeVars}
  1575.             return
  1576.         } elseif {[lindex $values 1]} {
  1577.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  1578.         } elseif {[lindex $values 2]} {
  1579.             if {![catch {htmlNewFooter $footers} newfoot]} {
  1580.                 lappend footers $newfoot
  1581.                 set footers [lsort $footers]
  1582.                 set this [file tail $newfoot]
  1583.                 set touchedIt 1
  1584.             }
  1585.         } else {
  1586.             set i [lsearch -exact $foot $this]
  1587.             set footerFile [lindex $footers $i]
  1588.             if {[lindex $values 5]} {
  1589.                 if {![catch {readFile $footerFile} footText]} {
  1590.                     insertText "\r$footText\r"
  1591.                     set HTMLmodeVars(footers) $footers
  1592.                     lappend modifiedModeVars {footers HTMLmodeVars}
  1593.                     message "$this inserted."
  1594.                     return
  1595.                 } else {
  1596.                     alertnote "Could not read $this."
  1597.                 }
  1598.             } else {
  1599.                 set footers [lreplace $footers $i $i]
  1600.                 set touchedIt 1
  1601.             }
  1602.         }
  1603.     }    
  1604. }
  1605.  
  1606. # Define a file as a footer.
  1607. proc htmlNewFooter {footers} {
  1608.     set newFooter [getfile "Select the file with the footer."]
  1609.     if {![htmlIsTextFile $newFooter alertnote]} {
  1610.         error ""
  1611.     } elseif {[lsearch -exact $footers $newFooter] < 0} {
  1612.         # Can't define two footers with the same file name.
  1613.         foreach f $footers {
  1614.             if {[file tail $f] == [file tail $newFooter]} {
  1615.                 alertnote "There is already a footer with the filename\
  1616.                 '[file tail $newFooter]'. Two footers with the same filename\
  1617.                 cannot be defined."
  1618.                 error ""
  1619.             }
  1620.         }
  1621.         return $newFooter
  1622.     } else {
  1623.         alertnote "'[file tail $newFooter]' already a footer."
  1624.         error ""
  1625.     }
  1626. }
  1627.  
  1628.  
  1629. #===============================================================================
  1630. # Last modified
  1631. #===============================================================================
  1632.  
  1633. proc htmlInsertLastMod {} {
  1634.     global HTMLmodeVars
  1635.     set values [dialog -w 300 -h 190 -t "Last modified tags" 40 10 200 30 \
  1636.     -e $HTMLmodeVars(lastModified) 10 40 290 55 -t "Date format" 10 70 100 90 \
  1637.     -r "Long" 1 10 95 70 115 -r "Abbreviated" 0 80 95 180 115 -r "Short" 0 190 95 250 115 \
  1638.     -c "Include weekday" 0 10 120 150 140 -c "Include time" 0 160 120 290 140 \
  1639.     -b OK 20 160 85 180 -b Cancel 110 160 175 180]
  1640.     if {[lindex $values 7]} {return}
  1641.     set lm [htmlQuote [lindex $values 0]]
  1642.     set indent [htmlFindNextIndent]
  1643.     set text "<!-- [htmlSetCase "#LASTMODIFIED TEXT"]=\"$lm\" [htmlSetCase FORM]=\""
  1644.     if {[lindex $values 1]} {append text [htmlSetCase LONG]}
  1645.     if {[lindex $values 2]} {append text [htmlSetCase ABBREV]}
  1646.     if {[lindex $values 3]} {append text [htmlSetCase SHORT]}
  1647.     if {[lindex $values 4]} {append text [htmlSetCase ",WEEKDAY"]}
  1648.     if {[lindex $values 5]} {append text [htmlSetCase ",TIME"]}
  1649.     append text "\" -->"
  1650.     set text "$text\r$indent[htmlGetLastMod $text]\r$indent<!-- [htmlSetCase /#LASTMODIFIED] -->"
  1651.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res] &&
  1652.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1653.         if {[askyesno "There are already 'last modified' tags in this document. Replace them?"] == "yes"} {
  1654.             replaceText [lindex $res 0] [lindex $res2 1] $text
  1655.         }
  1656.     } else {
  1657.         insertText [htmlOpenCR $indent 1] $text "\r$indent\r$indent"
  1658.     }
  1659. }
  1660.  
  1661. proc htmlLastModified {args} {
  1662.     set name [lindex $args [expr [llength $args] - 1]]
  1663.     if {[lindex [winNames -f] 0] != $name} {bringToFront $name}
  1664.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res]} {
  1665.         if {[catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1666.             alertnote "The window '[file tail $name]' contains an opening 'last modified' tag without a matching closing tag."
  1667.             return
  1668.         }
  1669.         set str [htmlGetLastMod [getText [lindex $res 0] [expr [lindex $res 1] + 1]]]
  1670.         if {$str == "0"} {
  1671.             alertnote "The window '[file tail $name]' contains invalid 'last modified' tags."
  1672.         } else {
  1673.             set indent [htmlFindIndent [lindex $res 0]]
  1674.             replaceText [lindex $res 1] [lindex $res2 0] "\r" $indent $str "\r" $indent
  1675.         }
  1676.     }
  1677. }
  1678.  
  1679. proc htmlGetLastMod {str} {
  1680.     global htmlSpecialCharacter htmlSpecialCapCharacter
  1681.     set text ""
  1682.     set form ""
  1683.     set type ""
  1684.     if {![regexp -nocase {TEXT=\"([^\"]*)\"} $str dum text] ||
  1685.     ![regexp -nocase {FORM=\"([^\"]*)\"} $str dum form] || $form == "" ||
  1686.     ![regexp -nocase {[^,]*} $form type] || 
  1687.     [lsearch -exact [list LONG ABBREV SHORT] [string toupper $type]] < 0} {return 0}
  1688.     set text [htmlUnQuote $text]
  1689.     set day [string match "*WEEKDAY*" [string toupper $form]]
  1690.     set tid [string match "*TIME*" [string toupper $form]]
  1691.     set date [mtime [now] [string tolower $type]]
  1692.     if {!$day && [string toupper $type] != "SHORT"} {
  1693.         set date [lreplace $date 0 0 [lrange [lindex $date 0] 1 end]]
  1694.     }
  1695.     if {!$tid} {
  1696.         set date [lindex $date 0]
  1697.     } else {
  1698.         set tiden [lindex $date 1]
  1699.         regexp {^[0-9]+[^0-9]+[0-9]+} $tiden tidstr
  1700.         set tiden [lreplace $tiden 0 0 $tidstr]
  1701.         set date [lreplace $date 1 1 $tiden]
  1702.     }
  1703.     set text "$text [join $date]"
  1704.     regsub -all "&" $text "\\&" text
  1705.     regsub -all "<" $text "\\<" text
  1706.     regsub -all ">" $text "\\>" text
  1707.     regsub -all "¿" $text "\\¿" text
  1708.     regsub -all "¡" $text "\\¡" text
  1709.     foreach c [array names htmlSpecialCharacter] {
  1710.         regsub -all $c $text "\\&$htmlSpecialCharacter($c);" text
  1711.     }
  1712.     foreach c [array names htmlSpecialCapCharacter] {
  1713.         regsub -all $c $text "\\&$htmlSpecialCapCharacter($c);" text
  1714.     }
  1715.     foreach c [list eth ETH thorn THORN] {
  1716.         regsub -all "&$c;" $text $c text
  1717.     }
  1718.     return $text
  1719. }
  1720.  
  1721. #===============================================================================
  1722. # Home page windows
  1723. #===============================================================================
  1724.  
  1725. proc htmlOpenHPwin {{folder ""}} {
  1726.     global htmlHomePageWinList
  1727.     # Get folder to open.
  1728.     if {$folder == "" && [catch {htmlGetDir "Open:"} folder]} {return}
  1729.     set tail [file tail $folder]
  1730.     # Is their already a window for this folder?
  1731.     foreach win $htmlHomePageWinList {
  1732.         if {[lindex $win 0] == $folder} {
  1733.             bringToFront [lindex $win 1]
  1734.             return
  1735.         }    
  1736.     }
  1737.     if {[catch {glob $folder:*} fileList]} {beep; message "Empty folder."; return}
  1738.     
  1739.     set text "$folder\rcmd-shift-C to copy URL\r"
  1740.     foreach fil $fileList {
  1741.         append text [file tail $fil] \r
  1742.     }
  1743.     if {[set winsize [htmlGetHPwinSize $folder]] == ""} {
  1744.         new -n $tail -m Home
  1745.     } else {
  1746.         eval new -n [list "$tail"] -g $winsize -m Home
  1747.     }
  1748.     insertText $text
  1749.     if {$winsize == ""} {shrinkWindow 1}
  1750.     # make folders boldface
  1751.     for {set i 0} {$i < [llength $fileList]} {incr i} {
  1752.         set fil [lindex $fileList $i]
  1753.         if {[file isdirectory $fil]} {
  1754.             insertColorEscape [rowColToPos [expr $i + 3] 0] bold
  1755.             insertColorEscape [rowColToPos [expr $i + 4] 0] 12
  1756.         }
  1757.     }
  1758.     htmlSetWin
  1759.     lappend htmlHomePageWinList [list $folder [lindex [winNames] 0]]
  1760. }
  1761.  
  1762. # Reads a saved home page window size.
  1763. proc htmlGetHPwinSize {folder} {
  1764.     global PREFS htmlHPwinPositions
  1765.     if {[info exists htmlHPwinPositions($folder)]} {return $htmlHPwinPositions($folder)}
  1766.     if {![file exists "$PREFS:HTML:Home page window positions"]} {return}
  1767.     set cid [scancontext create]
  1768.     set pos ""
  1769.     scanmatch $cid "^\{?$folder\[ \}\]" {
  1770.         if {[lindex $matchInfo(line) 0] == $folder} {set pos [lrange $matchInfo(line) 1 end]}
  1771.     }
  1772.     set fid [open "$PREFS:HTML:Home page window positions"]
  1773.     scanfile $cid $fid
  1774.     close $fid
  1775.     scancontext delete $cid
  1776.     return $pos
  1777. }
  1778.  
  1779. proc htmlQuitHook {} {
  1780.     global PREFS htmlHPwinPositions
  1781.     if {![info exists htmlHPwinPositions]} {return}
  1782.     message "Saving home page window positions…"
  1783.     set current ""
  1784.     if {[file exists "$PREFS:HTML:Home page window positions"] && 
  1785.     ![catch {open "$PREFS:HTML:Home page window positions"} fid]} {
  1786.         set current [split [read -nonewline $fid] \n]
  1787.         close $fid
  1788.     }
  1789.     foreach c $current {
  1790.         if {[info exists htmlHPwinPositions([lindex $c 0])]} {
  1791.             append n [lrange $c 0 0] " " $htmlHPwinPositions([lindex $c 0]) \n
  1792.             unset htmlHPwinPositions([lindex $c 0])
  1793.         } else {
  1794.             append n $c \n
  1795.         }
  1796.     }
  1797.     foreach c [array names htmlHPwinPositions] {
  1798.         append n [list $c] " " $htmlHPwinPositions($c) \n
  1799.     }
  1800.     if {![catch {open "$PREFS:HTML:Home page window positions" w} fid]} {
  1801.         puts -nonewline $fid $n
  1802.         close $fid
  1803.     }
  1804. }
  1805.  
  1806.  
  1807. # Quick search in home page windows just like in Finder windows.
  1808. proc htmlSearchInHPwin {char} {
  1809.     global homeTime hpWinString
  1810.     set t [ticks]
  1811.     if {[expr $t - $homeTime] > 60} {set hpWinString ""}
  1812.     append hpWinString $char
  1813.     set homeTime $t
  1814.     if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "^$hpWinString" [nextLineStart [nextLineStart 0]]} res]} {return}
  1815.     select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1816. }
  1817.  
  1818. proc htmlHomeReturn {} {
  1819.     global htmlHomePageWinList HTMLmodeVars
  1820.     foreach win $htmlHomePageWinList {
  1821.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1822.             set f [htmlGetAhpLine]
  1823.             if {![file exists $f]} {alertnote "[file tail $f] not found."; return}
  1824.             if {[file isdirectory $f]} {
  1825.                 htmlOpenHPwin $f
  1826.             } else {
  1827.                 getFileInfo $f a
  1828.                 if {$a(type) == "TEXT"} {
  1829.                     edit -c $f
  1830.                 } elseif {$HTMLmodeVars(homeOpenNonTextFile)} {
  1831.                     if {$a(type) == "APPL"} {
  1832.                         launch -f $f
  1833.                     } elseif {$a(creator) == "MACS"} {
  1834.                         beep; message "Cannot open."
  1835.                     } else {
  1836.                         launchDoc $f
  1837.                     }
  1838.                 } else {
  1839.                     beep; message "Not a text file."
  1840.                 }
  1841.             }
  1842.             return
  1843.         }
  1844.     }    
  1845. }
  1846.  
  1847. proc htmlHpWinBack {} {
  1848.     global htmlHomePageWinList
  1849.     foreach win $htmlHomePageWinList {
  1850.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1851.             set folder [file dirname [getText 0 [expr [nextLineStart 0] - 1]]]
  1852.             if {$folder != ""} {htmlOpenHPwin $folder}
  1853.             return
  1854.         }
  1855.     }
  1856. }
  1857.  
  1858. proc htmlGetAhpLine {} {
  1859.     return "[getText 0 [expr [nextLineStart 0] - 1]]:[getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]"
  1860. }
  1861.  
  1862. # Refreshes a Home page window.
  1863. proc htmlRefreshHpWin {{hpwin ""}} {
  1864.     global htmlHomePageWinList
  1865.     if {$hpwin == ""} {
  1866.         foreach win $htmlHomePageWinList {
  1867.             if {[lindex [winNames] 0] == [lindex $win 1]} {
  1868.                 set hpwin $win
  1869.             }
  1870.         }
  1871.     }
  1872.     set curSel [file tail [htmlGetAhpLine]]
  1873.     set folder [lindex $hpwin 0]
  1874.     setWinInfo read-only 0
  1875.     if {![file exists ${folder}:] || [catch {glob $folder:*} files]} {killWindow; return}
  1876.     set len [llength $files]
  1877.     set pos [nextLineStart [nextLineStart 0]]
  1878.     set ind 0
  1879.     while {$pos < [maxPos] && $ind < $len} {
  1880.         set f [file tail [lindex $files $ind]]
  1881.         set t [string trim [getText $pos [nextLineStart $pos]]]
  1882.         while {$pos < [maxPos] && $ind < $len && $t == $f} {
  1883.             incr ind
  1884.             set pos [nextLineStart $pos]
  1885.             set f [file tail [lindex $files $ind]]
  1886.             set t [string trim [getText $pos [nextLineStart $pos]]]
  1887.         }
  1888.         if {[string compare [string tolower $t] [string tolower $f]] == 1} {
  1889.             goto $pos
  1890.             insertText $f \r
  1891.             if {[file isdirectory [lindex $files $ind]]} {
  1892.                 insertColorEscape $pos bold
  1893.                 if {![file isdirectory [lindex $files [expr $ind + 1]]]} {
  1894.                     insertColorEscape [nextLineStart $pos] 12
  1895.                 }
  1896.             } elseif {[file isdirectory [lindex $files [expr $ind + 1]]]} {
  1897.                 insertColorEscape $pos 12
  1898.                 insertColorEscape [nextLineStart $pos] bold
  1899.             }            
  1900.             set pos [nextLineStart $pos]
  1901.             incr ind
  1902.         } else {
  1903.             deleteText $pos [nextLineStart $pos]
  1904.         }
  1905.         if {$pos < [maxPos]} {set t [string trim [getText $pos [nextLineStart $pos]]]}
  1906.         set f [file tail [lindex $files $ind]]
  1907.     }
  1908.     if {$pos < [maxPos]} {
  1909.         deleteText [expr $pos - 1] [maxPos]
  1910.     } else {
  1911.         goto [maxPos]
  1912.         foreach f [lrange $files $ind end] {
  1913.             insertText [file tail $f] \r
  1914.             if {[file isdirectory $f]} {
  1915.                 insertColorEscape $pos bold
  1916.                 insertColorEscape [nextLineStart $pos] 12
  1917.             }
  1918.             set pos [nextLineStart $pos]    
  1919.         }
  1920.     }
  1921.     refresh
  1922.     setWinInfo dirty 0
  1923.     setWinInfo read-only 1
  1924.     beginningOfBuffer
  1925.     if {![catch {search -s -f 1 -m 0 -r 1 -- "^$curSel" 0} res]} {
  1926.         select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1927.     }
  1928. }
  1929.  
  1930. proc htmlRefreshWindows {} {
  1931.     global htmlHomePageWinList
  1932.     set frontWin [lindex [winNames -f] 0]
  1933.     foreach win $htmlHomePageWinList {
  1934.         bringToFront [lindex $win 1]
  1935.         htmlRefreshHpWin $win
  1936.     }
  1937.     bringToFront $frontWin
  1938. }
  1939.  
  1940. # Copies an URL from a home page window.
  1941. proc htmlCopyURL {} {
  1942.     global htmlHomePageWinList htmlHomePageWinURL
  1943.     foreach win $htmlHomePageWinList {
  1944.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1945.             set htmlHomePageWinURL [htmlGetAhpLine]
  1946.             message "$htmlHomePageWinURL copied."
  1947.         }
  1948.     }
  1949. }
  1950.  
  1951. # Pastes a previously copied URL from a home page window.
  1952. proc htmlPasteURL {} {
  1953.     global htmlHomePageWinURL htmlIsSel htmlCurSel HTMLmodeVars
  1954.     if {![info exists htmlHomePageWinURL]} {message "No URL to paste."; return}
  1955.     if {[set link [htmlGetFile $htmlHomePageWinURL 2]] == ""} {return}
  1956.     set url [htmlURLescape2 [lindex $link 0]]
  1957.     htmlGetSel
  1958.     set absPos [getPos]
  1959.     set htmlWrapPos [lindex [posToRowCol [getPos]] 1]
  1960.     if {[llength [set wh [lindex $link 1]]]} {
  1961.         set text [htmlSetCase <IMG]
  1962.         append text [htmlWrapTag "[htmlSetCase SRC=]\"$url\""]
  1963.         append text [htmlWrapTag [htmlSetCase "WIDTH=\"[lindex $wh 0]\""]]
  1964.         append text [htmlWrapTag [htmlSetCase "HEIGHT=\"[lindex $wh 1]\">"]]
  1965.         set closing ""
  1966.     } else {
  1967.         set text "<[htmlSetCase A]"
  1968.         append text [htmlWrapTag [htmlSetCase HREF=]\"$url\">]
  1969.         set closing [htmlCloseElem A]
  1970.         if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append closing "•"}
  1971.     }
  1972.     append text $htmlCurSel
  1973.     set currpos [expr [getPos] + [string length $text]]
  1974.     append text $closing
  1975.     if {$htmlIsSel} { deleteSelection }
  1976.     insertText $text
  1977.     if {!$htmlIsSel} {
  1978.         goto $currpos
  1979.     }
  1980. }
  1981.  
  1982.  
  1983. # closeHook
  1984. proc htmlCloseHook {name} {
  1985.     global htmlHomePageWinList
  1986.     set tmp ""
  1987.     foreach win $htmlHomePageWinList {
  1988.         if {$name != [lindex $win 1]} {
  1989.             lappend tmp $win
  1990.         }
  1991.     }
  1992.     set htmlHomePageWinList $tmp
  1993. }
  1994.  
  1995. # deactivateHook
  1996. proc htmldeactivateHook {name} {
  1997.     global htmlHPwinPositions
  1998.     set winSize [getGeometry]
  1999.     # When closing size is {0 0 0 0}
  2000.     if {$winSize == {0 0 0 0}} {return}
  2001.     set htmlHPwinPositions([string trim [getText 0 [nextLineStart 0]]]) $winSize
  2002. }
  2003.  
  2004. namespace eval Home {}
  2005. proc Home::DblClick {from to} {htmlHomeReturn}
  2006.  
  2007. foreach __char {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 . _ -} {
  2008.     bind '$__char' "htmlSearchInHPwin $__char" Home
  2009. }
  2010. unset __char
  2011.  
  2012. bind '\r' htmlHomeReturn Home
  2013. bind down <c> htmlHomeReturn Home
  2014. bind enter htmlHomeReturn Home
  2015. bind down     downBrowse Home
  2016. bind up     upBrowse Home
  2017. bind '\r' <c> htmlHpWinBack Home
  2018. bind enter <c> htmlHpWinBack Home
  2019. bind up <c> htmlHpWinBack Home
  2020. bind 'r' <c> htmlRefreshHpWin Home
  2021. bind 'c' <cs> htmlCopyURL Home
  2022.  
  2023.  
  2024. #===============================================================================
  2025. # Validation
  2026. #===============================================================================
  2027.  
  2028. proc htmlFindUnbalancedTags {} {
  2029.     global tileLeft tileTop tileWidth errorHeight htmlPackageToUse
  2030.     
  2031.     message "Searching for unbalanced tags…"
  2032.     set fil [stripNameCount [lindex [winNames -f ] 0]]
  2033.     # These may not have an closing tag.
  2034.     set empty {!DOCTYPE BASEFONT BR AREA LINK IMG PARAM HR INPUT ISINDEX BASE META}
  2035.     if {$htmlPackageToUse == 1} {lappend empty  COL FRAME SPACER WBR EMBED BGSOUND KEYGEN}
  2036.     # These have an optional closing tag.
  2037.     set closingOptional {P DT DD LI OPTION TR TD TH HEAD BODY HTML WINDOW}
  2038.     if {$htmlPackageToUse == 1} {lappend closingOptional COLGROUP THEAD TBODY TFOOT}
  2039.     # These have an optional opening tag.
  2040.     set openingOptional {HTML HEAD BODY}
  2041.     if {$htmlPackageToUse == 1} {lappend openingOptional TBODY}
  2042.     
  2043.     set tagStack WINDOW
  2044.     set pos 0
  2045.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  2046.         set tagstart [lindex $res 0]
  2047.         set tagend   [lindex $res 1]
  2048.         set tagtxt [getText $tagstart $tagend]
  2049.         if {$tagtxt == "<!--"} {
  2050.             # Comment
  2051.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  2052.                 set pos [lindex $res 1]
  2053.             } else {
  2054.                 set pos [maxPos]
  2055.             }
  2056.             continue
  2057.         }
  2058.         # get element name
  2059.         if {![regexp {<[ \t\r]*([^ \t\r]+).*>} $tagtxt tmp tag]} {
  2060.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2061.             set pos $tagend
  2062.             continue
  2063.         }
  2064.         set tag [string toupper $tag]
  2065.         # is this a closing tag?
  2066.         if {[string index $tag 0] == "/"} {
  2067.             set tag [string range $tag 1 end]
  2068.             if {[lsearch -exact $empty $tag] >= 0} {
  2069.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2070.             } elseif {[lsearch -exact $tagStack $tag] < 0 && [lsearch -exact $openingOptional $tag] < 0} {
  2071.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2072.             } else {
  2073.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2074.                     if {[set this [lindex $tagStack $i]] != $tag} {
  2075.                         if {[lsearch -exact $closingOptional $this] < 0} {
  2076.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2077.                         }
  2078.                     } else {
  2079.                         break
  2080.                     }
  2081.                 }
  2082.                 set tagStack [lrange $tagStack [expr $i + 1 ] end]
  2083.             }
  2084.         } else {
  2085.             # opening tag
  2086.             if {[lsearch -exact $empty $tag] < 0} {
  2087.                 set tagStack [concat $tag $tagStack]
  2088.             }
  2089.         }
  2090.         set pos $tagend
  2091.     }
  2092.     # check if there are unclosed tags.
  2093.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2094.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  2095.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2096.         }
  2097.     }
  2098.     if {[info exists errtxt]} {
  2099.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  2100.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  2101.         insertText $errtxt
  2102.         htmlSetWin
  2103.     } else {
  2104.         alertnote "No unbalanced tags found!"
  2105.     }
  2106.  
  2107. }
  2108.  
  2109. proc htmlCheckTags {} {
  2110.     global tileLeft tileTop tileWidth errorHeight htmlPackageToUse
  2111.     
  2112.     message "Checking tags…"
  2113.     set fil [stripNameCount [lindex [winNames -f ] 0]]
  2114.     
  2115.     eval htmlCheckConfig$htmlPackageToUse
  2116.     
  2117.     # Validate
  2118.     set headHasBeen 0
  2119.     set bodyHasBeen 0
  2120.     set htmlHasBeen 0
  2121.     set tagStack WINDOW
  2122.     set currentTag WINDOW
  2123.     set pos 0
  2124.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  2125.         set tagstart [lindex $res 0]
  2126.         set tagend   [lindex $res 1]
  2127.         set tagtxt [getText $tagstart $tagend]
  2128.         # get element name
  2129.         if {$tagtxt != "!--" && ![regexp {<[ \t\r]*([^ \t\r>]+)} $tagtxt tmp tag]} {
  2130.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2131.             set pos $tagend
  2132.             continue
  2133.         } else {
  2134.             set tag [string toupper $tag]
  2135.         }
  2136.         if {$tagstart > $pos} {
  2137.             set prevTxt [getText $pos [expr $tagstart -1]]
  2138.         } else {
  2139.             set prevTxt ""
  2140.         }
  2141.         # check for unmatched < or > in text.
  2142.         if {[regexp {<} $prevTxt]} {
  2143.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched <.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2144.         }
  2145.         if {[regexp {>} $prevTxt]} {
  2146.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched >.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2147.         }
  2148.         
  2149.         # check for text if current element may not contain text.
  2150.         set back 0
  2151.         if {[lsearch -exact $mayContain($currentTag) text] < 0 &&
  2152.         ![regexp {^[ \t\r]*$} $prevTxt ]} {
  2153.             # back up and insert BODY if needed
  2154.             if {!$bodyHasBeen && [lsearch -exact $tagStack BODY] < 0 &&
  2155.             !($htmlPackageToUse == 1 && [lsearch -exact $tagStack FRAMESET] >= 0)} {
  2156.                 set tagend $pos
  2157.                 set tag BODY
  2158.                 set back 1
  2159.             } else {
  2160.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $currentTag may not contain text.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2161.             }
  2162.         }
  2163.         if {!$back && $tagtxt == "<!--"} {
  2164.             # Comment
  2165.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  2166.                 set pos [lindex $res 1]
  2167.             } else {
  2168.                 set pos [maxPos]
  2169.             }
  2170.             continue
  2171.         }
  2172.         # Silently ignore !DOCTYPE
  2173.         if {$tag == "!DOCTYPE"} {
  2174.             set pos $tagend
  2175.             continue
  2176.         }
  2177.         # back up and insert HEAD if needed.
  2178.         if {!$headHasBeen && [lsearch -exact $mayContain(HEAD) $tag] >= 0} {
  2179.             set tagend $pos
  2180.             set tag HEAD
  2181.         }
  2182.         # back up and insert TBODY if needed
  2183.         if {$htmlPackageToUse == 1 && $currentTag == "TABLE" && [lsearch -exact $mayContain(TABLE) $tag] < 0} {
  2184.             set tagend $pos
  2185.             set tag TBODY
  2186.         }
  2187.         set xtag [string trimleft $tag /]
  2188.         # insert BODY if tag can't be in HEAD or HEAD is closed.
  2189.         if {!$bodyHasBeen && ([lsearch -exact $mayContain(HEAD) $xtag] < 0 ||
  2190.         [lsearch -exact $tagStack HEAD] < 0) &&
  2191.         $xtag != "HTML" && $xtag != "HEAD" && $xtag != "BODY" && 
  2192.         !($htmlPackageToUse == 1 && $xtag == "FRAMESET" || [lsearch -exact $tagStack FRAMESET] >= 0)} {
  2193.             set tagend $pos
  2194.             set tag BODY
  2195.         }
  2196.         # insert HTML if not done
  2197.         if {!$htmlHasBeen && $tag != "HTML"} {
  2198.             set tagend $pos
  2199.             set tag HTML
  2200.         }
  2201.         
  2202.         # check if there's anything after </HTML>
  2203.         if {$tag == "/HTML"} {
  2204.             if {![regexp {^[ \t\r]*$} [getText $tagend [maxPos]]]} {
  2205.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Text after </HTML>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2206.             }
  2207.             break
  2208.         }
  2209.         # is this a closing tag?
  2210.         if {[string index $tag 0] == "/"} {
  2211.             set tag [string range $tag 1 end]
  2212.             if {![info exists mayContain($tag)]} {
  2213.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2214.             } else {
  2215.                 if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2216.                 if {$tag == "BODY"} {set bodyHasBeen 1}
  2217.                 if {[lsearch -exact $empty $tag] >= 0} {
  2218.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2219.                 } elseif {[lsearch -exact $tagStack $tag] < 0} {
  2220.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2221.                 } else {
  2222.                     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2223.                         if {[set this [lindex $tagStack $i]] != $tag} {
  2224.                             if {[lsearch -exact $closingOptional $this] < 0} {
  2225.                                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2226.                             }
  2227.                         } else {
  2228.                             break
  2229.                         }
  2230.                     }
  2231.                     set tagStack [lrange $tagStack [expr $i + 1 ] end]
  2232.                     set currentTag [lindex $tagStack 0]
  2233.                 }
  2234.             }
  2235.         } else {
  2236.             # opening tag
  2237.             if {$headHasBeen && $tag == "HEAD"} {
  2238.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HEAD tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2239.             } 
  2240.             if {$bodyHasBeen && $tag == "BODY"} {
  2241.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple BODY tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2242.             }
  2243.             if {$htmlHasBeen && $tag == "HTML"} {
  2244.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HTML tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2245.             }
  2246.             if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2247.             if {$tag == "BODY"} {set bodyHasBeen 1}
  2248.             if {$tag == "HTML"} {set htmlHasBeen 1}
  2249.             # unknown tag?
  2250.             if {[set em [lsearch -exact $empty $tag]] < 0 && ![info exists mayContain($tag)]} {
  2251.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2252.             } else {
  2253.                 # implicitely close those which may not contain $tag.
  2254.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2255.                     set this [lindex $tagStack $i]
  2256.                     if {[lsearch -exact $mayContain($this) $tag] < 0 || [lsearch -exact $form $tag] >= 0 && [lsearch -exact $tagStack FORM] < 0} {
  2257.                         # Silently close those with an optional closing tag except BODY and HTML.
  2258.                         if {[lsearch -exact $closingOptional $this] < 0 || $this == "BODY" || $this == "HTML"} {
  2259.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this may not contain $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2260.                             break
  2261.                         }
  2262.                     } else {
  2263.                         break
  2264.                     }
  2265.                 }
  2266.                 if {$em < 0} {
  2267.                     set tagStack [concat $tag [lrange $tagStack $i end]]
  2268.                     set currentTag $tag
  2269.                 } else {
  2270.                     set tagStack [lrange $tagStack $i end]
  2271.                 }
  2272.             }
  2273.         }
  2274.         set pos $tagend
  2275.     }
  2276.     # check if there are unclosed tags.
  2277.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2278.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  2279.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2280.         }
  2281.     }
  2282.     if {[info exists errtxt]} {
  2283.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  2284.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to line)\r\r"
  2285.         insertText $errtxt
  2286.         htmlSetWin
  2287.     } else {
  2288.         alertnote "No syntax errors found! (Attributes have not been checked.)"
  2289.     }
  2290. }
  2291.